home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus Special 25 / AMIGAplus Sonderheft 25 (2000)(Falke)(DE)(Track 1 of 4)[!].iso / Rexx / Whirlpool.pprx < prev    next >
Text File  |  2000-05-08  |  14KB  |  510 lines
  1. /* Personal Paint Amiga Rexx script - Copyright © 1996, 1997 Cloanto Italia srl */
  2.  
  3. /* $VER: Whirlpool.pprx 1.2 */
  4.  
  5. /** ENG
  6.  This script creates a text "whirlpool": a text string is rendered
  7.  along an elliptical path, using a vector font in the current foreground
  8.  color.
  9.  
  10.  This is a "tool macro": the mouse can be used to define an ellipse.
  11.  When the mouse button is released, a settings requester is
  12.  displayed. The settings include: font, text string, text size, start angle,
  13.  antialiasing, etc.
  14.  
  15.  If a single point (pixel), rather than an area, is selected, a requester
  16.  with the previously-used area coordinates is displayed: the parameters can
  17.  be modified to fine-tune the appearance of the "whirlpool".
  18.  
  19.  The text string specified in the settings requester may contain color
  20.  control sequences, in the format "Esc[3#m" or "[#]", where # is a pen
  21.  number (0 .. 256). The default (initial) color is the current foreground
  22.  color.
  23. */
  24.  
  25. /** DEU
  26.  Mit diesem Skript läßt sich ein Text-"Whirlpool" erzeugen. Dazu wird
  27.  eine Textzeichenkette dem Verlauf eines elliptischen Pfades angepaßt,
  28.  wobei ein Vektorfont in der aktuellen Vordergrundfarbe verwendet wird.
  29.  
  30.  Dies ist ein sog. "Tool-Makro": Zunächst wird mit Hilfe der Maus
  31.  die Ellipse erstellt. Sobald die Maustaste losgelassen wird, öffnet
  32.  sich ein Dialogfenster zur Festlegung von Einstellungen für Font,
  33.  Textstring, Zeichengröße, Startwinkel, Kantenglättung, usw.
  34.  
  35.  Wird anstelle eines Bereichs lediglich ein einzelner Punkt selektiert,
  36.  so öffnet sich ein Dialogfenster mit den zuletzt verwendeten
  37.  Bereichskoordinaten, welche sich dann zur Feinabstimmung des
  38.  Erscheinungsbildes den Anforderungen entsprechend modifizieren lassen.
  39.  
  40.  Hinweis: Der im Dialogfenster "Einstellungen" festgelegte Textstring kann
  41.  auch mit Steuerzeichen zur Aktivierung einer bestimmten Farbe versehen
  42.  werden. Diese müssen im Format "Esc[3#m]" oder "[#]" vorliegen, wobei das
  43.  Rautenzeichen # die Stiftnummer (0...256) angibt. Standardmäßig ist die
  44.  aktuelle Vordergrundfarbe eingestellt.
  45. */
  46.  
  47. /** ITA
  48.  Questo script crea un testo a "vortice": una stringa di testo è tracciata
  49.  lungo un percorso ellittico, usando un font vettoriale col colore di primo
  50.  piano corrente.
  51.  
  52.  È una "macro per strumenti": si può usare il mouse per definire una ellisse;
  53.  quando si rilascia il tasto del mouse, compare una finestra di dialogo per
  54.  l'impostazione dei parametri. I parametri comprendono: font, stringa di
  55.  testo, dimensioni del testo, smorzamento seghettature (antialiasing), ecc.
  56.  
  57.  Se si seleziona un punto singolo (pixel) anziché un'area, compare una finestra
  58.  di dialogo che mostra le coordinate dell'area precedente: tali parametri
  59.  possono essere modificati per raffinare l'aspetto del "vortice".
  60.  
  61.  La stringa di testo specificata nella finestra di dialogo delle impostazioni
  62.  può contenere sequenze di controllo per colori, nel formato "Esc[3#m" o "[#]",
  63.  dove # è il numero di un colore (0 .. 256). Il colore predefinito (iniziale)
  64.  è quello corrente di primo piano.
  65. */
  66.  
  67. IF ARG(1, EXISTS) THEN
  68.     PARSE ARG PPPORT button x0 y0 .
  69. ELSE
  70.     EXIT 0  /* macro execution only */
  71.  
  72. ADDRESS VALUE PPPORT
  73. OPTIONS RESULTS
  74. OPTIONS FAILAT 10000
  75.  
  76. Get 'LANG'
  77. IF RESULT = 1 THEN DO        /* Deutsch */
  78.     txt_title_zone    = "Whirlpool-Bereich"
  79.     txt_gad_x0        = "Zentrum _X:"
  80.     txt_gad_y0        = "Zentrum _Y:"
  81.     txt_gad_radiusx   = "_Radius X:"
  82.     txt_gad_radiusy   = "Radiu_s Y:"
  83.     txt_title_set     = "Whirlpool-Einstellungen"
  84.     txt_gad_font      = "_Font:"
  85.     txt_gad_text      = "_Text:"
  86.     txt_string_text   = "Dies ist Text für den Whirlpool-Effekt."
  87.     txt_gad_sheight   = "_Höhe Anfang:"
  88.     txt_gad_eheight   = "Höhe _Ende:"
  89.     txt_gad_fall      = "_Gefälle %:"
  90.     txt_gad_sangle    = "Winkel A_nfang:"
  91.     txt_gad_aalias    = "_Kantenglättung:"
  92.     txt_gad_aalias0   = "Keine"
  93.     txt_gad_aalias1   = "Schwach"
  94.     txt_gad_aalias2   = "Mittel"
  95.     txt_gad_aalias3   = "Stark"
  96.     txt_err_nofonts   = "Vektorfonts nicht auffindbar"
  97.     txt_err_procss    = "Fehler bei Bildbearbeitung: "
  98.     txt_err_small     = "Ausgewählter Bereich ist zu klein"
  99.     txt_err_nomem     = "Zu wenig Speicher"
  100.     txt_err_oldclient = "Für dieses Skript_ist eine neuere Version_von Personal Paint erforderlich"
  101. END
  102. ELSE IF RESULT = 2 THEN DO    /* Italiano */
  103.     txt_title_zone    = "Zona spirale"
  104.     txt_gad_x0        = "Centro _X:"
  105.     txt_gad_y0        = "Centro _Y:"
  106.     txt_gad_radiusx   = "_Raggio X:"
  107.     txt_gad_radiusy   = "Raggi_o Y:"
  108.     txt_title_set     = "Parametri spirale"
  109.     txt_gad_font      = "_Font:"
  110.     txt_gad_text      = "_Testo:"
  111.     txt_string_text   = "Questo è un testo a spirale."
  112.     txt_gad_sheight   = "Altezza i_niziale:"
  113.     txt_gad_eheight   = "Altezza fina_le:"
  114.     txt_gad_fall      = "_Caduta %:"
  115.     txt_gad_sangle    = "Ang_olo iniziale:"
  116.     txt_gad_aalias    = "Antialia_s:"
  117.     txt_gad_aalias0   = "Nessuno"
  118.     txt_gad_aalias1   = "Basso"
  119.     txt_gad_aalias2   = "Medio"
  120.     txt_gad_aalias3   = "Alto"
  121.     txt_err_nofonts   = "Non vi sono font vettoriali"
  122.     txt_err_procss    = "Errore elaborazione immagine: "
  123.     txt_err_nomem     = "Memoria insufficiente"
  124.     txt_err_small     = "L'area definita è troppo piccola"
  125.     txt_err_oldclient = "Questa procedura richiede_una versione più recente_di Personal Paint"
  126. END
  127. ELSE DO            /* English */
  128.     txt_title_zone    = "Whirlpool Area"
  129.     txt_gad_x0        = "Center _X:"
  130.     txt_gad_y0        = "Center _Y:"
  131.     txt_gad_radiusx   = "_Radius X:"
  132.     txt_gad_radiusy   = "Radiu_s Y:"
  133.     txt_title_set     = "Whirlpool Settings"
  134.     txt_gad_font      = "_Font:"
  135.     txt_gad_text      = "_Text:"
  136.     txt_string_text   = "This is a whirlpool text."
  137.     txt_gad_sheight   = "_Start Height:"
  138.     txt_gad_eheight   = "_End Height:"
  139.     txt_gad_fall      = "Fa_ll %:"
  140.     txt_gad_sangle    = "Start _Angle:"
  141.     txt_gad_aalias    = "A_ntialias:"
  142.     txt_gad_aalias0   = "None"
  143.     txt_gad_aalias1   = "Low"
  144.     txt_gad_aalias2   = "Medium"
  145.     txt_gad_aalias3   = "High"
  146.     txt_err_nofonts   = "Vector fonts not found"
  147.     txt_err_procss    = "Image processing error: "
  148.     txt_err_small     = "The selected area is too small"
  149.     txt_err_nomem     = "Not enough memory"
  150.     txt_err_oldclient = "This script requires a newer_version of Personal Paint"
  151. END
  152.  
  153. Version 'REXX'
  154. IF RESULT < 7 THEN DO
  155.     RequestNotify 'PROMPT "'txt_err_oldclient'"'
  156.     EXIT 10
  157. END
  158.  
  159.  
  160. /* Ellipse Definition */
  161.  
  162. GetCurrentBrush
  163. savebsh = RESULT
  164. SetCurrentBrush 'RECTANGULAR WIDTH 1 HEIGHT 1'
  165.  
  166. prev_xp = x0
  167. prev_yp = y0
  168. drawn = 0
  169.  
  170. DO FOREVER
  171.     GetMousePosition
  172.     PARSE VAR RESULT xp yp .
  173.  
  174.     IF xp ~= prev_xp | yp ~= prev_yp | ~drawn THEN DO
  175.         IF drawn THEN
  176.             Undo
  177.         radiusx = ABS(x0 - xp)
  178.         radiusy = ABS(y0 - yp)
  179.         DrawEllipse x0 y0 radiusx radiusy
  180.  
  181.         prev_xp = xp
  182.         prev_yp = yp
  183.         drawn = 1
  184.     END
  185.     ELSE WaitForEvent
  186.  
  187.     GetMouseButton
  188.     IF RESULT ~= button THEN
  189.         LEAVE
  190. END
  191.  
  192. Undo
  193. SetCurrentBrush savebsh
  194.  
  195.  
  196. FreeBrush
  197. IF RC ~= 0 THEN
  198.     EXIT RC
  199.  
  200. /* Setting Requester */
  201.  
  202. def_font_path = "FONTS:"
  203. max_text_size = 8000
  204.  
  205. font_path = LoadSet('PP_VectorPath', def_font_path, 1, 0)
  206.  
  207.  
  208. ftot = 0
  209. vftfname = 'ENV:PP_VectorFonts'
  210. IF ~OPEN(fexists, vftfname) THEN DO
  211.     ADDRESS COMMAND 'List >'vftfname' 'font_path' PAT=#?.otag NOHEAD LFORMAT="%s"'
  212.     ADDRESS COMMAND 'Sort 'vftfname vftfname'.s'
  213.     IF RC = 0 THEN DO
  214.         ADDRESS COMMAND 'Delete >NIL: 'vftfname
  215.         ADDRESS COMMAND 'Copy >NIL: 'vftfname'.s' vftfname
  216.         ADDRESS COMMAND 'Delete >NIL: 'vftfname'.s'
  217.     END
  218. END
  219. ELSE CALL CLOSE(fexists)
  220.  
  221. IF OPEN('listfile', vftfname) THEN DO
  222.     DO FOREVER
  223.         fline = READLN('listfile')
  224.         IF EOF('listfile') THEN BREAK
  225.         ftot = ftot + 1
  226.         fontname.ftot = LEFT(fline, LENGTH(fline) - 5)
  227.     END
  228.     CALL CLOSE('listfile')
  229. END
  230.  
  231. IF ftot = 0 THEN DO
  232.     RequestNotify 'PROMPT "'txt_err_nofonts'"'
  233.     EXIT 10
  234. END
  235.  
  236.  
  237. IF radiusx < 2 & radiusy < 2 THEN DO        /* simple click */
  238.     lastpar = LoadSet('LastParams', '0 0 100 100')
  239.     PARSE VAR lastpar x0 y0 radiusx radiusy
  240.     Request '"'txt_title_zone'" ' ||,
  241.             '"INTSTR = ""'txt_gad_x0'"", 0, 32000, 'x0' ' ||,
  242.              'INTSTR = ""'txt_gad_y0'"", 0, 32000, 'y0' ' ||,
  243.              'INTSTR = ""'txt_gad_radiusx'"", 1, 32000, 'radiusx' ' ||,
  244.              'INTSTR = ""'txt_gad_radiusy'"", 1, 32000, 'radiusy' "'
  245.     IF RC ~= 0 THEN
  246.         EXIT RC
  247.     x0 = RESULT.1
  248.     y0 = RESULT.2
  249.     radiusx = RESULT.3
  250.     radiusy = RESULT.4
  251. END
  252.  
  253.  
  254. fntnum  = LoadSet('Font', 0)
  255. text    = LoadSet('Text', txt_string_text)
  256. height  = LoadSet('StartHeight', 50)
  257. eheight = LoadSet('EndHeight', 20)
  258. f